home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / CHKASTH.SRC < prev    next >
Text File  |  1990-11-03  |  27KB  |  1,086 lines
  1. ;\|
  2. ;CHKASTH.SRC     Translated from CHKASTH.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;CHECK_UP 00:14:26 AM   3/ 5/90   |
  4. DO_DEFINES:
  5.     define(CTR2|N|1||)
  6.     define(ISITCLIN|A|1||)
  7.     define(fld_lctr|N|2||)
  8.     define(FLAG|A|1||)
  9.     define(YES.NO|A|1||)
  10.     define(MEM_FEV_PC|N|5|2|)
  11.     define(CTR3|N|1||)
  12.     define(CTR6|N|2||)
  13.     define(MEM_NAME_CHK|A|27||)
  14.     define(PROC4|A|1||)
  15.     define(REF_CTR|N|2||)
  16.     define(MEM_DOC2|N|1||)
  17.     define(CON_CTR|N|2||)
  18.     define(EXTRAS|N|3||)
  19.     define(CON_NUM|N|3||)
  20.     define(CLIN_NUM|N|3||)
  21.     define(EMERG_NUM|N|3||)
  22.     define(ISIT_EMER|A|1||)
  23.     define(MEM_FEV|N|5|2|)
  24.     define(MEM_DOC|A|1||)
  25.     define(NY|A|1||)
  26.     define(AGE|N|2||)
  27.     define(BP_DROP|N|2||)
  28.     define(MEM_CTR|N|1||)
  29.     define(FBS_ADD|N|5|2|)
  30.     define(MEM_BP_AGE|N|3||)
  31.     define(AOD|A|1||15)
  32.     define(TD|S|8||)
  33.     define(MN|A|30||15)
  34.     define(DO|A|8||15)
  35.     define(QU|A|10||15)
  36.     define(DS|A|30||15)
  37.     define(QTY|N|3||15)
  38.     define(ISN|N|3||15)
  39.     define(CTR|N|2||)
  40.     define(CTR2|N|2||)
  41.     define(LNE.LNGTH|N|2||)
  42.     define(OK|A|1||)
  43.     define(LNE.LN2|N|2||)
  44.     define(NUM.MSG|N|2||)
  45.     define(MESSAGE|A|78||15)
  46.     define(ENT.MASK|A|10||)
  47.     define(LLC|N|2||)
  48.     define(WD|N|2||)
  49.     define(HT|N|2||)
  50.     define(MCNTR|N|5||)
  51.     define(MCNTR2|N|5||)
  52.     define(MCNTR3|N|5||)
  53.     define(MCNTR4|N|5||)
  54.     define(MEM_DIAB|A|1||)
  55.     define(MEM_NEW|A|1||)
  56.     define(MEM_BP|A|1||)
  57.     define(MEM_THY|A|1||)
  58.     define(MEM_OLD|A|1||)
  59.     define(MEM_RECD|S|8||)
  60.     define(MEM_RECT|S|8||)
  61.     define(MEM_RECB|S|8||)
  62. OPEN_FILES:
  63.     open(PATIENT||0|EXIT)
  64.     open(DIABETIC||1|EXIT)
  65.     open(RP||0|)
  66.     open(RECALLS||0|)
  67.     open(REFER||0|EXIT)
  68.     open(PROCEDE||1|EXIT)
  69.     open(MEMORY||0|EXIT)
  70.     open(GPSETUP||0|EXIT)
  71. STARTCHK:
  72.     trap(S|G|SAVE_RECS)
  73.     trap(D|I)
  74.     trap(C|G|CLR_RECS)
  75.     trap(Q|G|EXIT)
  76.     trap(J|I)
  77. MOUNT_SCRS:
  78.     mount(SCREEN2|S||)
  79.     date(TD|G)
  80. START_UP:
  81.     trap(J|I)
  82.     MEM_BP = ("Y")
  83. PAT.NAME:
  84.     clrlne(1|22)
  85.     enter(PATIENT.NAME||||||||)
  86.     find(G|PATIENT.NAME|PAT.NAME|)
  87.     DIAB_REF = (RECORD.NUMBER)
  88.     find(M|DIAB_REF|NO_DIABX|)
  89. NO_DIAB:
  90.     goto STARTALL
  91. NO_DIAB2:
  92.     gosub GET_AGE
  93.     trap(%|I)
  94.     trap(U|I)
  95.     saves(10)
  96.     window(20|12|2|35)
  97.     ISITCLIN = ("")
  98.     pmsg("Is this a clinic or update?"|1|1|N|N|S|)
  99.     enter(ISITCLIN|"YN"|||Y|Y|N|30|1|N)
  100.     if ISITCLIN = ("Y") then CHECK_DATE = (TD)
  101.     trap(%|D)
  102.     trap(U|D)
  103.     redsp(10)
  104.     MEM_CTR = (9)
  105.     enter(CHECK_DATE||||N|Y|N|||N)
  106.     enter(CHECK_OP||||Y|Y|N|||N)
  107.     if CHECK_OP = ("") reent
  108.     enter(CHK_DOC|"1234"|||N|Y|N|||N)
  109.     enter(DOC_BP1|"1234567890"|||N|Y|N|||N)
  110.     enter(DOC_BP2|"1234567890"|||N|Y|N|||N)
  111.     if DOC_BP1 > (0) then MEM_BP = ("Y")
  112. NO_DIAB3:
  113.     FLAG = ("X")
  114.     trap(J|G|RUN_MEMO)
  115.     enter(SMOK||SMOK_HLP||N|Y|N|||N)
  116.     if SMOK > (0) gosub SMOK_MSG
  117.     enter(EXERCISE||EX_HLP||N|Y|N|||N)
  118.     enter(ALCOHOL||ALC_HLP||N|Y|N|||N)
  119.     enter(ANGINA||ANG_HLP||N|Y|N|||N)
  120.     enter(DIET|"GB "|DIET_HLP||Y|Y|N|||N)
  121.     enter(WT1||||N|Y|N|||N)
  122.     enter(WT2||||N|Y|N|||N)
  123.     IDEAL_WT = (WT2-81*0.85)
  124.     if WT1 > (IDEAL_WT) gosub WEIGHT
  125.     enter(PROT|" T+"|||N|N|N|||N)
  126.     if PROT => ("+") gosub REF_PROT
  127.     enter(SUG||SUG_HLP||N|N|N|||N)
  128.     if SUG > (0.25) gosub REF_SUG
  129.     enter(BP_CHECK_NUM|" 123"|||N|Y|N|||N)
  130.     enter(BP1||||N|Y|N|||N)
  131.     enter(BP2||||N|Y|N|||N)
  132.     enter(BP1S||BPST_HLP||N|Y|N|||N)
  133.     gosub BP_CHECK
  134.     enter(PULSE||||N|Y|N|||N)
  135.     if PULSE > (120) gosub FAST
  136.     if PULSE < (56) gosub SLOW
  137.     enter(REG|" YN"|REG_HLP||Y|Y|N|||N)
  138.     if REG = ("N") then enter(APEX||||N|Y|N|||N)
  139.     if APEX <> (0) then if APEX > (120) gosub FAST
  140.     if APEX <> (0) then if APEX < (56) gosub SLOW
  141.     enter(SUGAR||FEV_HLP||N|Y|N|||N)
  142.     enter(FEV||FEV_HLP||N|Y|N|||N)
  143.     MEM_FEV_PC = (FEV/SUGAR*100)
  144.     if MEM_FEV_PC => (80) then DRUG_TYPE = (1)
  145.     if MEM_FEV_PC < (80) then DRUG_TYPE = (2)
  146.     if MEM_FEV_PC < (50) then DRUG_TYPE = (3)
  147.     if MEM_FEV_PC < (30) do
  148.         {
  149.         REF_CHECK = ("Y")
  150.         DRUG_TYPE = (4)
  151.         }
  152.     enter(CHOL||||N|Y|N|||N)
  153.     enter(COMMENT1||||Y|Y|N|||N)
  154.     enter(COMMENT2||||Y|Y|N|||N)
  155.     gosub DRUGSCH
  156.     enter(DRUGS_CHECKED|"NY"|||Y|Y|N|||N)
  157.     enter(REF_CHECK|"NY"|||Y|Y|N|||N)
  158.     NEXT_CHECK = (CHECK_DATE+186)
  159.     enter(NEXT_CHECK||||N|Y|N|||N)
  160.     YES.NO = ("")
  161.     enter(YES.NO|"YN"|||Y|Y|N|||N)
  162.     if YES.NO = ("Y") gosub PRINT
  163. SAVE_RECS:
  164.     if RECORD.NUMBER = (0) goto PAT.NAME
  165. SAVE_DONE:
  166.     COD.REF = (RECORD.NUMBER)
  167.     find(M|COD.REF|NOCOD|)
  168.     COD.D[8] = (NEXT_CHECK)
  169.     COD.D[7] = (0)
  170.     save(RECALLS|N|Y)
  171.     DIAB_REF = (RECORD.NUMBER)
  172.     CHECK_TYPE = (9)
  173.     save(DIABETIC|N|Y)
  174.     find(M|RECORD.NUMBER|EXIT|)
  175.     save(PATIENT|N|Y)
  176.     if FLAG = ("Y") then run("recmenu")
  177.     FLAG = ("")
  178. STARTX:
  179.     MEM_DIAB = ("")
  180.     MEM_NEW = ("")
  181.     MEM_BP = ("")
  182.     MEM_THY = ("")
  183.     MEM_CTR = (0)
  184.     MEM_RECD = (0)
  185.     MEM_NAME_CHK = ("")
  186.     MEM_RECT = (0)
  187.     MEM_CTR = (0)
  188.     MEM_OLD = ("")
  189.     MEM_RECB = (0)
  190.     AGE = (0)
  191.     BP_DROP = (0)
  192.     FBS_ADD = (0)
  193.     MEM_BP_AGE = (0)
  194.     for(CTR|12|23|1)
  195.         {
  196.         clrlne(1|CTR)
  197.         }
  198.     pmsg("F1 - Help  F2 - Memo  [Ctrl-Y]- Print"|1|24|N|N|S|)
  199.     clr(PATIENT|B)
  200.     goto START_UP
  201. DEL_RECS:
  202.     del(DIABETIC|Y|)
  203.     clr(PATIENT|B)
  204.     goto STARTX
  205. CLR_RECS:
  206.     clr(PATIENT|B)
  207.     clr(DIABETIC|B)
  208.     goto STARTX
  209. EXIT:
  210.     if FLAG = ("X") do
  211.         {
  212.         FLAG = ("Y")
  213.         goto SAVE_DONE
  214.         }
  215.     run("recmenu")
  216. PRT.MSG:
  217.     LNE.LNGTH = (0)
  218.     for(MCNTR|1|NUM.MSG|1)
  219.         {
  220.         LNE.LN2 =siz(A|MESSAGE[MCNTR])
  221.         if LNE.LN2 > (LNE.LNGTH) then LNE.LNGTH = (LNE.LN2)
  222.         }
  223.     NUM.MSG = (NUM.MSG + 1)
  224.     if LNE.LNGTH < (26) then LNE.LNGTH = (26)
  225.     LNE.LNGTH = (LNE.LNGTH + 4)
  226.     LLC = (40 - (LNE.LNGTH / 2))
  227.     HT = (NUM.MSG + 3)
  228.     WD = (LNE.LNGTH + 1)
  229.     saves(1)
  230.     window(LLC|24|HT|WD)
  231.     NUM.MSG = (NUM.MSG - 1)
  232.     pmsg(""||||||)
  233.     for(MCNTR|1|NUM.MSG|1)
  234.         {
  235.         pmsg(MESSAGE[MCNTR]|3||N|N|S|)
  236.         }
  237.     pmsg("Press any key to continue"|3||Y|N|S|)
  238.     redsp(1)
  239.     ret
  240. NO_DIABX:
  241.     clr(DIABETIC|B)
  242.     MESSAGE[1] = ("NO CHECK UP RECORD FOR THIS PATIENT")
  243.     NUM.MSG = (1)
  244.     gosub PRT.MSG
  245.     goto NO_DIAB
  246. SEEALL:
  247. STARTALL1:
  248. STARTALL:
  249.     if RECORD.NUMBER = (0) goto ENDIT
  250.     COD.REF = (RECORD.NUMBER)
  251.     find(M|COD.REF|NEXTALL2|)
  252.     MEM_RECB = (COD.D[9])
  253. NEXTALL2:
  254.     RP.REF = (RECORD.NUMBER)
  255.     find(M|RP.REF|ENDITX|)
  256.     CTR = (1)
  257. TESTALL:
  258.     if CTR = (12) goto ENDIT
  259.     AOD[CTR] = (AUTO.ON.DEMAND)
  260.     MN[CTR] = (MEDICATION)
  261.     DO[CTR] = (DOSE)
  262.     QU[CTR] = (QUANTITY)
  263.     DS[CTR] = (DIRECTIONS)
  264.     QTY[CTR] = (RP.DISP.QTY)
  265.     ISN[CTR] = (ISSUE.NO)
  266.     trim(MN[CTR]|T)
  267.     trim(QU[CTR]|T)
  268.     just(QU[CTR]|L)
  269.     trim(DO[CTR]|T)
  270.     just(DO[CTR]|L)
  271.     trim(DS[CTR]|T)
  272.     just(DS[CTR]|L)
  273.     pmsg(AOD[CTR];" ";MN[CTR];" ";DO[CTR];" ";QU[CTR];" ";DS[CTR];" ";QTY[CTR];" ";ISN[CTR]|1|CTR2|N|N|S|)
  274.     CTR2 = (CTR+11)
  275.     find(N|RP|ENDIT|)
  276.     if RP.REF <> (RECORD.NUMBER) goto ENDIT
  277.     CTR = (CTR+1)
  278.     goto TESTALL
  279. CLEARXALL:
  280.     clr(RP|B)
  281.     clr(RECALLS|B)
  282.     clrmem(AOD|15)
  283.     clrmem(MN|15)
  284.     clrmem(DO|15)
  285.     clrmem(QU|15)
  286.     clrmem(DS|15)
  287.     clrmem(QTY|15)
  288.     clrmem(ISN|15)
  289.     ret
  290. ENDIT:
  291.     find(M|RECORD.NUMBER|PAT.NAME|)
  292.     DIAB_REF = (RECORD.NUMBER)
  293.     find(M|DIAB_REF|NO_DIAB2|)
  294.     goto NO_DIAB2
  295. ENDITX:
  296.     MESSAGE[1] = ("NO DRUGS ON REPEAT")
  297.     NUM.MSG = (1)
  298.     gosub PRT.MSG
  299.     goto ENDIT
  300. GET_AGE:
  301.     AGE = (TD-DATE.OF.BIRTH/365)
  302.     ret
  303. BP_CHECK:
  304.     if MEM_BP = ("Y") do
  305.         {
  306.         if BP_CHECK_NUM => (2) do
  307.             {
  308.             if BP1 > (DOC_BP1) gosub REFER_BP
  309.             if BP2 > (DOC_BP2) gosub REFER_BP
  310.             BP_DROP = (BP1-BP1S)
  311.             if BP_DROP > (20) gosub REFER_BP
  312.             }
  313.         ret
  314.         }
  315.     else
  316.         {
  317.         if BP_CHECK_NUM = (2) do
  318.             {
  319.             if BP1 > (AGE+110) gosub REFER_BP
  320.             }
  321.         if BP2 > (105) gosub REFER_BP
  322.         BP_DROP = (BP1-BP1S)
  323.         if BP_DROP > (20) gosub REFER_BP
  324.         }
  325.     ret
  326. REF_FBS:
  327.     if FBS_CHECK_NUM = (2) do
  328.         {
  329.         FBS_ADD = (FBS+FBS2)
  330.         if FBS_ADD > (14) gosub FBS_MSG
  331.         }
  332.     ret
  333. REF_HBA:
  334.     if HBA > (8) gosub HBA_MSG
  335.     ret
  336. SMOK_HLP:
  337.     MESSAGE[1] = ("Number per day eg 16")
  338.     NUM.MSG = (1)
  339.     gosub PRT.MSG
  340.     ret
  341. SMOK_MSG:
  342.     MESSAGE[1] = ("There is a risk of cancer,heart disease,gangrene,and bronchitis")
  343.     NUM.MSG = (1)
  344.     gosub PRT.MSG
  345.     ret
  346. REF_PROT:
  347.     MESSAGE[1] = ("If there is more than a trace -send sample for orgs and sens.")
  348.     MESSAGE[2] = ("Refer to Dr if protein persists etc")
  349.     NUM.MSG = (2)
  350.     gosub PRT.MSG
  351.     ret
  352. SUG_HLP:
  353.     MESSAGE[1] = ("Enter sugar in urine as a decimal eg 1/4 = .25")
  354.     NUM.MSG = (1)
  355.     gosub PRT.MSG
  356.     ret
  357. REF_SUG:
  358.     MESSAGE[1] = ("Do a blood sugar.If high refer to Dr.")
  359.     MESSAGE[2] = ("If patient is a diabetic refer to Dr if more than a third of tests over .25")
  360.     NUM.MSG = (2)
  361.     gosub PRT.MSG
  362.     ret
  363. REG_HLP:
  364.     MESSAGE[1] = ("Enter a Y if regular or a N if not. Do apical rate if N")
  365.     NUM.MSG = (1)
  366.     gosub PRT.MSG
  367.     ret
  368. REFER_BP:
  369.     MESSAGE[1] = ("There is a definate BP problem here - refer to Dr.")
  370.     NUM.MSG = (1)
  371.     REF_CHECK = ("Y")
  372.     gosub PRT.MSG
  373.     ret
  374. BPST_HLP:
  375.     MESSAGE[1] = ("Enter standing systolic - It should not drop more than 20")
  376.     NUM.MSG = (1)
  377.     gosub PRT.MSG
  378.     ret
  379. DIET_HLP:
  380.     MESSAGE[1] = ("G = Good diet B = Bad diet ")
  381.     NUM.MSG = (1)
  382.     gosub PRT.MSG
  383.     ret
  384. EX_HLP:
  385.     MESSAGE[1] = ("Enter a number for hours per week exercise")
  386.     NUM.MSG = (1)
  387.     gosub PRT.MSG
  388.     ret
  389. FBS_MSG:
  390.     MESSAGE[1] = ("These are too high - refer to Dr.")
  391.     NUM.MSG = (1)
  392.     gosub PRT.MSG
  393.     REF_CHECK = ("Y")
  394.     ret
  395. HBA_MSG:
  396.     MESSAGE[1] = ("Poor control here - refer to Dr.")
  397.     NUM.MSG = (1)
  398.     gosub PRT.MSG
  399.     REF_CHECK = ("Y")
  400.     ret
  401. VIS_HLP:
  402.     MESSAGE[1] = ("Use Snellen test type eg 6 ")
  403.     NUM.MSG = (1)
  404.     gosub PRT.MSG
  405.     ret
  406. RET_HLP:
  407.     MESSAGE[1] = ("Retinopathy 0,1,2,3,4,5 ")
  408.     NUM.MSG = (1)
  409.     gosub PRT.MSG
  410.     ret
  411. FOOT_HLP:
  412.     MESSAGE[1] = ("Y = Pulses present N = No pulses")
  413.     NUM.MSG = (1)
  414.     gosub PRT.MSG
  415.     ret
  416. SENS_HLP:
  417.     MESSAGE[1] = ("Y = Tuning fork sensation present N = Not present")
  418.     NUM.MSG = (1)
  419.     gosub PRT.MSG
  420.     ret
  421. DRUGSCH:
  422.     MESSAGE[1] = ("NOW CHECK PATIENTS DRUG THERAPY IS CORRECT")
  423.     NUM.MSG = (1)
  424.     gosub PRT.MSG
  425.     mount(DRUGSCR|S)
  426.     RP.REF = (RECORD.NUMBER)
  427.     find(M|RP.REF|NOSCR|)
  428.     CTR = (17)
  429. NEXTRPS:
  430.     trim(MEDICATION|T)
  431.     if CTR = (29) do
  432.         {
  433.         pmsg("There are more drugs"|60|20|N|N|D|)
  434.         goto NOSCR
  435.         }
  436.     if CTR => (23) do
  437.         {
  438.         CTR6 = (CTR-6)
  439.         pmsg(MEDICATION|31|CTR6|N|N|D|)
  440.         }
  441.     else
  442.         {
  443.         pmsg(MEDICATION|1|CTR|N|N|D|)
  444.         }
  445.     CTR = (CTR+1)
  446.     find(N|RP|NOSCR|)
  447.     if RP.REF <> (RECORD.NUMBER) goto NOSCR
  448.     goto NEXTRPS
  449. NOSCR:
  450.     enter(COMMENT1|||NOSCR|Y|Y|N|||N)
  451.     enter(COMMENT2||||Y|Y|N|||N)
  452.     mount(SCREEN2|S)
  453.     ret
  454. NOCOD:
  455.     COD.PAT.NAME = (PATIENT.NAME)
  456.     COD.REF = (RECORD.NUMBER)
  457.     save(RECALLS|N|N)
  458.     find(M|COD.REF||)
  459.     goto SAVE_RECS
  460. RUN_MEMO:
  461.     goto RUN_MEMOX
  462. RUN_MEMOX:
  463.     trap(J|G|EXIT_MEM)
  464.     trap(S|G|SAVE_MEMO)
  465.     trap(D|I)
  466.     trap(C|I)
  467.     trap(Q|G|EXIT_MEM)
  468.     trap(L|G|EXIT_MEM)
  469. MOUNT:
  470.     mount(NEW|S||)
  471. START:
  472.     enter(PATIENT.NAME||||Y|Y|N|||N)
  473.     find(G|PATIENT.NAME|START|)
  474.     PROC_REF = (RECORD.NUMBER)
  475.     find(M|PROC_REF|START2CL|)
  476.     NY = ("")
  477.     pmsg("DO YOU WANT TO UPDATE THE MEMOS FIRST:"|10|20|N|N|S|)
  478.     enter(NY|"YN"|||Y|Y|N|50|20|N)
  479.     if NY = ("Y") goto UPMEMO
  480.     clrlne(1|20)
  481. START2:
  482.     gosub LINE
  483.     if CTR2 = (0) then CTR2 = (1)
  484. SATRT3:
  485.     MEM_DOC = ("")
  486.     for(CTR|CTR2|6|1)
  487.         {
  488.         PROC_DATE[CTR] = (TD)
  489.         PROC_UP = (TD)
  490.         enter(PROC_DATE[CTR]|||SATRT3|N|N|N|||N)
  491.         enter(PROC[CTR]||||Y|Y|N|||N)
  492.         enter(PROC_DOC[CTR]|"12345"|||Y|Y|N|||N)
  493.         MEM_DOC = (PROC_DOC[CTR])
  494.         enter(PROC_OP[CTR]||||Y|Y|N|||N)
  495.         if PROC_OP[CTR] = ("") reent
  496.         if PROC_EX[CTR] = ("") do
  497.             {
  498.             PROC_REF = (RECORD.NUMBER)
  499.             PROC4 =mid(PROC[CTR]|1|1|)
  500.             if PROC4 = ("*") do
  501.                 {
  502.                 PROC_EX[CTR] = ("X")
  503.                 gosub STARTAGAIN
  504.                 save(PROCEDE|N|N)
  505.                 find(M|PROC_REF||)
  506.                 }
  507.             enter(PROC_DONE[1]|" YNSCRO"|||Y|Y|N|||N)
  508.             enter(PROC_DONE[2]|" YNSCRO"|||Y|Y|N|||N)
  509.             enter(PROC_DONE[3]|" YNSCRO"|||Y|Y|N|||N)
  510.             enter(PROC_DONE[4]|" YNSCRO"|||Y|Y|N|||N)
  511.             enter(PROC_DONE[5]|" YNSCRO"|||Y|Y|N|||N)
  512.             enter(PROC_DONE[6]|" YNSCRO"|||Y|Y|N|||N)
  513.             }
  514.         }
  515.     gosub LINE
  516.     for(CTR|1|6|1)
  517.         {
  518.         if PROC[CTR] = ("") then PROC_DATE[CTR] = (0)
  519.         }
  520.     goto SATRT3
  521. SAVE_MEMO:
  522.     for(CTR|1|6|1)
  523.         {
  524.         if PROC[1] = ("") do
  525.             {
  526.             clr(PROCEDE|B)
  527.             goto START
  528.             }
  529.         if PROC[CTR] = ("") do
  530.             {
  531.             PROC_DATE[CTR] = (0)
  532.             PROC_OP[CTR] = ("")
  533.             PROC_DOC[CTR] = ("")
  534.             PROC_DONE[CTR] = ("")
  535.             }
  536.         }
  537.     if PROC_REF = (0) goto START
  538.     PROC_REF = (RECORD.NUMBER)
  539.     if PROC_REF = (0) goto START
  540.     save(PROCEDE|Y|Y|)
  541.     MEM_DOC = ("")
  542.     goto START
  543. EXIT_MEM:
  544.     if PROC[1] = ("") goto RUNPATREC
  545.     for(CTR|1|6|1)
  546.         {
  547.         if PROC[CTR] = ("") do
  548.             {
  549.             PROC_DATE[CTR] = (0)
  550.             PROC_OP[CTR] = ("")
  551.             PROC_DOC[CTR] = ("")
  552.             PROC_DONE[CTR] = ("")
  553.             }
  554.         }
  555.     if PROC_REF > (0) then save(PROCEDE|N|Y)
  556. RUNPATREC:
  557.     trap(S|G|SAVE_RECS)
  558.     trap(D|I)
  559.     trap(C|G|CLR_RECS)
  560.     trap(Q|G|EXIT)
  561.     trap(J|G|RUN_MEMO)
  562.     mount(SCREEN2|S)
  563.     gosub STARTALLXX
  564.     goto PAT.NAME2
  565. LINE:
  566.     for(CTR2|1|6|1)
  567.         {
  568.         if PROC[CTR2] = ("") do
  569.             {
  570.             if CTR2 = (6) do
  571.                 {
  572.                 pops
  573.                 goto SATRT3
  574.                 }
  575.             ret
  576.             }
  577.         }
  578.     CTR = (2)
  579.     if PROC_DATE[1] = (TD) do
  580.         {
  581.         for(CTR3|1|6|1)
  582.             {
  583.             enter(PROC_DONE[CTR3]|" Y"|||Y|Y|N|||N)
  584.             }
  585.         pops
  586.         goto SAVE_MEMO
  587.         }
  588.     for(CTR2|1|5|1)
  589.         {
  590.         PROC[CTR2] = (PROC[CTR])
  591.         PROC_DATE[CTR2] = (PROC_DATE[CTR])
  592.         PROC_OP[CTR2] = (PROC_OP[CTR])
  593.         PROC_DOC[CTR2] = (PROC_DOC[CTR])
  594.         PROC_DONE[CTR2] = (PROC_DONE[CTR])
  595.         CTR = (CTR+1)
  596.         }
  597.     PROC[6] = ("")
  598.     PROC_DATE[6] = (0)
  599.     PROC_OP[6] = ("")
  600.     PROC_DOC[6] = ("")
  601.     PROC_DONE[6] = ("")
  602.     PROC_EX[6] = ("")
  603.     goto LINE
  604.     ret
  605. UPARROW:
  606.     CTR2 = (CTR2-1)
  607.     CTR = (CTR2)
  608.     ret
  609. STARTAGAIN:
  610.     trap(%|I)
  611.     trap(J|I)
  612.     trap(Q|G|EXITX)
  613.     trap(U|I)
  614.     trap(C|I)
  615.     trap(S|I)
  616.     saves(1)
  617.     window(20|15|5|40)
  618.     trap(Q|G|EXITX)
  619.     find(B|HEADING||)
  620.     pmsg("IS IT EMERGENCY:"|1|1|N|N|S|)
  621.     enter(ISIT_EMER|"YN"|||Y|Y|N|20|1|N)
  622.     if ISIT_EMER = ("Y") goto SCR2
  623.     gosub SCREEN2
  624.     CLIN_NUM = (CLIN_NUM)
  625.     pmsg("ENTER SPECIALTY:"|1|2|N|N|S|)
  626.     enter(CLIN_NUM||||N|Y|N|20|2|N)
  627. ADDER:
  628.     REF_COD = (MEM_DOC)
  629.     find(M|REF_COD|EXIT|)
  630.     if ISIT_EMER <> ("Y") do
  631.         {
  632.         CLIN_REF[CLIN_NUM] = (CLIN_REF[CLIN_NUM]+1)
  633.         }
  634.     else
  635.         {
  636.         EMERG_REF[EMERG_NUM] = (EMERG_REF[EMERG_NUM]+1)
  637.         }
  638.     save(REFER|N|Y)
  639.     CLIN_NUM = (0)
  640.     CON_NUM = (0)
  641.     EMERG_NUM = (0)
  642.     ISIT_EMER = ("")1
  643.     redsp(1)
  644.     trap(%|D)
  645.     trap(J|G|EXIT_MEM)
  646.     trap(U|D)
  647.     trap(Q|G|EXIT)
  648.     ret
  649. SCREEN2:
  650.     saves(2)
  651.     window(1|25|24|78)
  652.     for(REF_CTR|1|22|1)
  653.         {
  654.         pmsg(@R;REF_CTR;@N;" ";@R;CLINICS[REF_CTR];@N|1|REF_CTR|N|N|S|)
  655.         }
  656.     CON_CTR = (REF_CTR+1)
  657.     for(REF_CTR|1|22|1)
  658.         {
  659.         pmsg(@R;CON_CTR;@N;" ";@R;CLINICS[CON_CTR];@N|25|REF_CTR|N|N|S|)
  660.         CON_CTR = (CON_CTR+1)
  661.         }
  662.     pmsg("ENTER NUMBER:"|60|12|N|N|S|)
  663.     enter(CLIN_NUM||||N|Y|N|65|13|N)
  664.     if CLIN_NUM = (0) reent
  665.     if CLIN_NUM > (44) reent
  666.     redsp(2)
  667.     ret
  668. SCREEN3:
  669.     saves(2)
  670.     window(1|25|24|78)
  671.     for(REF_CTR|1|22|1)
  672.         {
  673.         pmsg(@R;REF_CTR;@N;" ";@R;CLINICS[REF_CTR];@N|1|REF_CTR|N|N|S|)
  674.         }
  675.     CON_CTR = (REF_CTR+1)
  676.     for(REF_CTR|1|22|1)
  677.         {
  678.         pmsg(@R;CON_CTR;@N;" ";@R;CLINICS[CON_CTR];@N|25|REF_CTR|N|N|S|)
  679.         CON_CTR = (CON_CTR+1)
  680.         }
  681.     pmsg("ENTER NUMBER:"|60|12|N|N|S|)
  682.     enter(EMERG_NUM||||N|Y|N|65|13|N)
  683.     if EMERG_NUM = (0) reent
  684.     if EMERG_NUM > (44) reent
  685.     redsp(2)
  686.     ret
  687. SCR2:
  688.     gosub SCREEN3
  689.     EMERG_NUM = (EMERG_NUM)
  690.     pmsg("ENTER SPECIALTY EMERGENCY:"|1|3|N|N|S|)
  691.     enter(EMERG_NUM||||N|Y|N|30|3|N)
  692.     goto ADDER
  693. EXITX:
  694.     goto STARTCHK
  695. UPMEMO:
  696.     enter(PROC_DONE[1]|" YNSCRO"|||Y|Y|N|||N)
  697.     enter(PROC_DONE[2]|" YNSCRO"|||Y|Y|N|||N)
  698.     enter(PROC_DONE[3]|" YNSCRO"|||Y|Y|N|||N)
  699.     enter(PROC_DONE[4]|" YNSCRO"|||Y|Y|N|||N)
  700.     enter(PROC_DONE[5]|" YNSCRO"|||Y|Y|N|||N)
  701.     enter(PROC_DONE[6]|" YNSCRO"|||Y|Y|N|||N)
  702.     clrlne(1|22)
  703.     goto START2
  704. START2CL:
  705.     clr(PROCEDE|B)
  706.     goto START2
  707. PAT.NAME2:
  708.     goto NO_DIAB3
  709. PRINT:
  710.     mount(CHKREP|R|P)
  711.     pset(128|24|24)
  712.     pchr(P|1)
  713.     pfmt(1|||N|N|)
  714.     pfmt(2|||N|N|)
  715.     pfmt(3|||N|N|)
  716.     pfmt(4|||N|N|)
  717.     pfmt(5|||N|N|)
  718.     pfmt(6|||N|N|)
  719.     pfmt(7|||N|N|)
  720.     fld_lctr = (0)
  721.     gosub PRINTRP
  722.     fld_lctr = (fld_lctr+7)
  723.     if fld_lctr = (24) goto MOUNTAGAIN
  724.     if REF_CHECK = ("Y") do
  725.         {
  726.         pmsg(%14;"                          REFERRED TO DOCTOR"|||N|N|P|)
  727.         fld_lctr = (fld_lctr+1)
  728.         }
  729.     CTR3 = (24-fld_lctr)
  730.     if CTR3 <= (0) goto MOUNTAGAIN
  731.     for(CTR2|1|CTR3|1)
  732.         {
  733.         pmsg(""|||N|N|P|)
  734.         }
  735. MOUNTAGAIN:
  736.     mount(SCREEN2|S)
  737.     gosub STARTALLXX
  738.     ret
  739. PRINTRP:
  740.     RP.REF = (RECORD.NUMBER)
  741.     find(M|RP.REF|RETPRINT|)
  742.     CTR = (1)
  743. TESTALLX:
  744.     if fld_lctr = (11) goto RETPRINT
  745.     fld_lctr = (fld_lctr+1)
  746.     AOD[CTR] = (AUTO.ON.DEMAND)
  747.     MN[CTR] = (MEDICATION)
  748.     DO[CTR] = (DOSE)
  749.     QU[CTR] = (QUANTITY)
  750.     DS[CTR] = (DIRECTIONS)
  751.     QTY[CTR] = (RP.DISP.QTY)
  752.     ISN[CTR] = (ISSUE.NO)
  753.     trim(MN[CTR]|T)
  754.     trim(QU[CTR]|T)
  755.     just(QU[CTR]|L)
  756.     trim(DO[CTR]|T)
  757.     just(DO[CTR]|L)
  758.     trim(DS[CTR]|T)
  759.     just(DS[CTR]|L)
  760.     pmsg(AOD[CTR];" ";MN[CTR];" ";DO[CTR];" ";QU[CTR];" ";DS[CTR];" ";QTY[CTR];" ";ISN[CTR]|||N|N|P|)
  761.     find(N|RP|RETPRINT|)
  762.     if RP.REF <> (RECORD.NUMBER) goto RETPRINT
  763.     CTR = (CTR+1)
  764.     goto TESTALLX
  765. RETPRINT:
  766.     PROC_REF = (RECORD.NUMBER)
  767.     find(M|PROC_REF|RETPRINTX|)
  768.     for(CTR2|1|6|1)
  769.         {
  770.         if PROC[CTR2] = ("") goto RETPRINTX
  771.         pmsg(PROC_DATE[CTR2];"   ";PROC[CTR2]|||N|N|P|)
  772.         fld_lctr = (fld_lctr+1)
  773.         }
  774. RETPRINTX:
  775.     ret
  776. STARTALLXX:
  777.     if RECORD.NUMBER = (0) goto ENDITXXX
  778.     COD.REF = (RECORD.NUMBER)
  779.     find(M|COD.REF|NEXTALL2XX|)
  780.     MEM_RECD = (COD.D[4])
  781.     MEM_RECT = (COD.D[6])
  782.     MEM_RECB = (COD.D[9])
  783. NEXTALL2XX:
  784.     RP.REF = (RECORD.NUMBER)
  785.     find(M|RP.REF|ENDITXXX|)
  786.     CTR = (1)
  787. TESTALLOP:
  788.     if CTR = (11) goto ENDITXXX
  789.     AOD[CTR] = (AUTO.ON.DEMAND)
  790.     MN[CTR] = (MEDICATION)
  791.     DO[CTR] = (DOSE)
  792.     QU[CTR] = (QUANTITY)
  793.     DS[CTR] = (DIRECTIONS)
  794.     QTY[CTR] = (RP.DISP.QTY)
  795.     ISN[CTR] = (ISSUE.NO)
  796.     trim(MN[CTR]|T)
  797.     trim(QU[CTR]|T)
  798.     just(QU[CTR]|L)
  799.     trim(DO[CTR]|T)
  800.     just(DO[CTR]|L)
  801.     trim(DS[CTR]|T)
  802.     just(DS[CTR]|L)
  803.     pmsg(AOD[CTR];" ";MN[CTR];" ";DO[CTR];" ";QU[CTR];" ";DS[CTR];" ";QTY[CTR];" ";ISN[CTR]|1|CTR2|N|N|S|)
  804.     CTR2 = (CTR+11)
  805.     find(N|RP|ENDITXXX|)
  806.     if RP.REF <> (RECORD.NUMBER) goto ENDITXXX
  807.     CTR = (CTR+1)
  808.     goto TESTALLOP
  809. ENDITXXX:
  810.     ret
  811. ALC_HLP:
  812.     MESSAGE[1] = ("ENTER NUMBER OF PINTS A WEEK - 1 PUB GIN=1/2 PINT")
  813.     NUM.MSG = (1)
  814.     gosub PRT.MSG
  815.     ret
  816. ANG_HLP:
  817.     MESSAGE[1] = ("ENTER NUMBER OF ATTACKS PER WEEK")
  818.     NUM.MSG = (1)
  819.     gosub PRT.MSG
  820.     ret
  821. WEIGHT:
  822.     MESSAGE[1] = ("THERE IS AN OBESITY PROBLEM HERE")
  823.     NUM.MSG = (1)
  824.     gosub PRT.MSG
  825.     ret
  826. OED_HLP:
  827.     MESSAGE[1] = ("Graded from 0 to 3")
  828.     NUM.MSG = (1)
  829.     gosub PRT.MSG
  830.     ret
  831. FAST:
  832.     MESSAGE[1] = ("Pulse is too fast - REFER")
  833.     NUM.MSG = (1)
  834.     gosub PRT.MSG
  835.     REF_CHECK = ("Y")
  836.     ret
  837. SLOW:
  838.     MESSAGE[1] = ("Pulse is too slow - do DIGOXIN level and Refer")
  839.     NUM.MSG = (1)
  840.     gosub PRT.MSG
  841.     REF_CHECK = ("Y")
  842.     ret
  843. FEV_HLP:
  844.     MESSAGE[1] = ("Enter ideal Fev based on age /wt/ht Program will calculate control as:-")
  845.     MESSAGE[2] = ("1 -Good Fev > 80%  2 - Moderate Fev 50-80%  3- Poor Fev < 30-50%")
  846.     MESSAGE[3] = ("If fev < 30% use Nebuliser and re-test. Refer if 30% or less")
  847.     NUM.MSG = (3)
  848.     gosub PRT.MSG
  849.     ret
  850. \STNEW     
  851.  
  852.  
  853.  
  854.  
  855.  
  856.                                  PROCEDURE ENTRY
  857.           ╔═══════════════════════════════════════════════════════════════╗
  858.           ║ &                          <&                     <&         <║
  859.           ║                                                               ║
  860.           ║  Date             Procedure                        Dr Rec Done║
  861.           ║ &         &                                        & &    &   ║
  862.           ║ &         &                                        & &    &   ║
  863.           ║ &         &                                        & &    &   ║
  864.           ║ &         &                                        & &    &   ║
  865.           ║ &         &                                        & &    &   ║
  866.           ║ &         &                                        & &    &   ║
  867.           ╚═══════════════════════════════════════════════════════════════╝
  868.           Esc - Exit and Save V=1 G=2 P=3 N=4 T=5 * for clinic,xray,path
  869.               Y=DONE S=SEE DR C=COL.SCRPT R=REPEAT O=OTHER N=NORMAL
  870.  
  871.  
  872.  
  873.  
  874.  
  875. \
  876. PATIENT.NAME
  877. ADDRESS1
  878. DATE.OF.BIRTH
  879. PROC_DATE[1]
  880. PROC[1]
  881. PROC_DOC[1]
  882. PROC_OP[1]
  883. PROC_DONE[1]
  884. PROC_DATE[2]
  885. PROC[2]
  886. PROC_DOC[2]
  887. PROC_OP[2]
  888. PROC_DONE[2]
  889. PROC_DATE[3]
  890. PROC[3]
  891. PROC_DOC[3]
  892. PROC_OP[3]
  893. PROC_DONE[3]
  894. PROC_DATE[4]
  895. PROC[4]
  896. PROC_DOC[4]
  897. PROC_OP[4]
  898. PROC_DONE[4]
  899. PROC_DATE[5]
  900. PROC[5]
  901. PROC_DOC[5]
  902. PROC_OP[5]
  903. PROC_DONE[5]
  904. PROC_DATE[6]
  905. PROC[6]
  906. PROC_DOC[6]
  907. PROC_OP[6]
  908. PROC_DONE[6]
  909. \
  910. \R CHKREP  
  911. ASTHMA CLINIC DETAILS:  &                          :&          ON &        BY &      Dr.&
  912. ================================================================================================================
  913. Smokes :&    Exrcise:&    Alcohol:&    Angina:&    Diet:&   Weight:&        Height:&       Ideal Wt:&
  914. Protein:&      Sugar:&       Drs. Rec. BP:&  /&    BP Chk Num:&  BP:&  /&     Standing Sys:&     Pulse:&  /&/&
  915. Fev:&   Ideal Fev:&      control:&
  916. Drugs Checked:&              Next Check:&
  917. Nurses comments:&                              &                               Nurses Sig:
  918.  
  919.  
  920.  
  921.  
  922.  
  923.  
  924.  
  925.  
  926.  
  927.  
  928.  
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  
  936.  
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943.  
  944.  
  945.  
  946.  
  947.  
  948.  
  949.  
  950.  
  951.  
  952.  
  953.  
  954.  
  955.  
  956.  
  957.  
  958.  
  959. \
  960. PATIENT.NAME
  961. DATE.OF.BIRTH
  962. TD
  963. CHECK_OP
  964. CHK_DOC
  965. SMOK
  966. EXERCISE
  967. ALCOHOL
  968. ANGINA
  969. DIET
  970. WT1
  971. WT2
  972. IDEAL_WT
  973. PROT
  974. SUG
  975. DOC_BP1
  976. DOC_BP2
  977. BP_CHECK_NUM
  978. BP1
  979. BP2
  980. BP1S
  981. PULSE
  982. REG
  983. APEX
  984. FEV
  985. SUGAR
  986. DRUG_TYPE
  987. DRUGS_CHECKED
  988. NEXT_CHECK
  989. COMMENT1
  990. COMMENT2
  991. \
  992. \SSSCREEN2 
  993. ASTHMA CLINIC  p p p p p p p p p p p p p p p p p p p p p p p p p p p  p p p p p p p p p p( p p) on  p p p p p p p p by  p p p p p p  ================
  994. =============================================================== Dr.Num:p p  Rec.Date:p p p p p p p p p Drug
  995. s Checked:p p Refrd:p p Nxt Chk:p p p p p p p p p Prnt N/Y:p p ================================================
  996. =============================== Smokes:p p p     Wt:p p p p p p p    Dr.BP:p p p p/ p p p      Ideal Fev: p p p p p p  
  997.                 Exerc :p p p     Ht:p p p p p p p   Chk.No:p p                  Fev: p p p                     
  998. Alcoh :p p p     IW:p p p p p p p       BP:p p p p/ p p p        Control: p                       Angina:p p p     Pr
  999. :p p p p p     St.Sys:p p p p            Cholest: p p p p p                   Diet  :p p      Su:p p p p p      Pulse
  1000. :p p p p:p p:p p p p                                      Com1  :p p p p p p p p p p p p p p p p p p p p p p p p p p p p p p p     Com2:p p
  1001.  p p p p p p p p p p p p p p p p p p p p p p p p p p p p p   ================================================================
  1002. ==============                                                                                  
  1003.                                                                                                 
  1004.                                                                                                 
  1005.                                                                                                 
  1006.                                                                                                 
  1007.                                                                                                 
  1008.                                                                                                 
  1009.                                                                                                 
  1010.                                                                                                 
  1011.                                                                                                 
  1012.                                                                                                 
  1013. \
  1014. PATIENT.NAME       27 A 15 1
  1015. DATE.OF.BIRTH      10 D 43 1
  1016. AGE                 2 N 54 1
  1017. CHECK_DATE          8 S 61 1
  1018. CHECK_OP            6 A 73 1
  1019. CHK_DOC             1 N  8 3
  1020. COD.D            8  8 S 20 3
  1021. DRUGS_CHECKED       1 A 43 3
  1022. REF_CHECK           1 A 51 3
  1023. NEXT_CHECK          8 S 61 3
  1024. YES.NO              1 A 79 3
  1025. SMOK                2 N  8 5
  1026. WT1                 52N 18 5
  1027. DOC_BP1             3 N 34 5
  1028. DOC_BP2             3 N 38 5
  1029. SUGAR               52N 57 5
  1030. EXERCISE            2 N  8 6
  1031. WT2                 52N 18 6
  1032. BP_CHECK_NUM        1 N 34 6
  1033. FEV                 3 N 57 6
  1034. ALCOHOL             2 N  8 7
  1035. IDEAL_WT            52N 18 7
  1036. BP1                 3 N 34 7
  1037. BP2                 3 N 38 7
  1038. DRUG_TYPE           1 N 57 7
  1039. ANGINA              2 N  8 8
  1040. PROT                4 A 18 8
  1041. BP1S                3 N 34 8
  1042. CHOL                42N 57 8
  1043. DIET                1 A  8 9
  1044. SUG                 32N 18 9
  1045. PULSE               3 N 34 9
  1046. REG                 1 A 38 9
  1047. APEX                3 N 40 9
  1048. COMMENT1           30 A  810
  1049. COMMENT2           30 A 4810
  1050. \
  1051. \STDRUGSCR 
  1052.               Digoxin      B-blockers    Diuretics  Tnt + Ca      Steroids
  1053.    ╔═════════════════════════════════════════════════════════════════════════╗
  1054.    ║CHECK║PULSE + APEX    ║FEV          ║OEDEMA    ║ANGINA       ║Wt.Urine.Bp║
  1055.    ║═════║════════════════║═════════════║══════════║═════════════║═══════════║
  1056.    ║TESTS║DIGOXIN LEVEL   ║U&E          ║U&E       ║NONE         ║U&E        ║
  1057.    ║     ║U & E           ║             ║URIC ACID ║             ║══════════ ║
  1058.    ║     ║                ║             ║BS        ║             ║Face       ║
  1059.    ║═════║════════════════║═════════════║══════════║═════════════║Diabetes   ║
  1060.    ║SIDE ║NAUSEA,VOMIT    ║COLD EXTREMS ║GOUT      ║HEADACHE     ║BP         ║
  1061.    ║     ║DIZZY,COLOR VIS.║             ║          ║             ║Bones      ║
  1062.    ║═════║════════════════║═════════════║══════════║═════════════║═══════════║
  1063.    ║REFER║PULSE >120 <56  ║PULSE <50    ║DYSPNEA+  ║ANGINA WORSE ║Any        ║
  1064.    ║     ║                ║FEV 33% LESS ║          ║             ║           ║
  1065.    ╚═════════════════════════════════════════════════════════════════════════╝
  1066.    Pulse:&  /&/&    Fev:&    Oed:& Angina:&   Com:&
  1067.                Drugs                          Com:&
  1068.  
  1069.  
  1070.  
  1071.  
  1072.  
  1073.  
  1074.  
  1075.  
  1076. \
  1077. PULSE
  1078. REG
  1079. APEX
  1080. FEV
  1081. OEDEMA
  1082. ANGINA
  1083. COMMENT1
  1084. COMMENT2
  1085. \
  1086.